home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1993 / Internet Info CD-ROM (Walnut Creek) (1993).iso / networking / terms / kermit / d / guts.exi < prev    next >
Encoding:
Text File  |  1988-08-16  |  7.6 KB  |  190 lines
  1.  DBEX     TITLE 'IEFDB401 - EXIT TO DYNALLOC, SVC 99'
  2.           PRINT OFF
  3.           COPY  $GUCGBL
  4.           COPY  $GUCSET
  5.           PRINT &ON,&GEN,&DATA
  6.           OSHEAD NAME=IEFDB401
  7.           SPACE 3
  8.  ******************************************************************
  9.  *.
  10.  *.    IEFDB401                                        83-02-17
  11.  *.                                      LAST CHANGED: 84-10-30
  12.  *.
  13.  *.    USER-WRITTEN VALIDATION ROUTINE THAT CHECKS DSNAME IN
  14.  *.    A REQUEST TO SVC 99. IF DSNAME STARTS WITH ID (TSO-
  15.  *.    PREFIX), THE ID IS EXCHANGED FOR JCTINDEX, AS TO MAINTAIN
  16.  *.    GUC-STANDARD IN DSNAME.
  17.  *.
  18.  *.    IEFDB401 RESIDES IN LOAD MODULE IEFW21SD.
  19.  *.
  20.  *.    FOR REFERENCE, SEE:
  21.  *.    OS/VS2 MVS SYSTEM PROGRAMMING LIBRARY: JOB MANAGEMENT
  22.  *.
  23.  ******************************************************************
  24.  IEFDB401 CSECT ,
  25.           USING *,15
  26.           B     *+14                BRANCH AROUND ID
  27.           DC    X'08',C'IEFDB401 '
  28.           STM   R14,R12,12(R13)     SAVE REGISTERS
  29.  **
  30.  **       REGISTER DISPOSITION:
  31.  **
  32.  **       R1    POINTER TO ADDRESS-LIST
  33.  **       R2    POINTER TO TEXT UNIT POINTER LIST
  34.  **       R3    POINTER TO JCT
  35.  **       R4    POINTER TO JOBNAME
  36.  **       R5    POINTER TO TEXT UNIT
  37.  **       R6    WORK REGISTER
  38.  **       R7    WORK REGISTER
  39.  **       R8    POINTER TO WORK-AREA
  40.  **       R9    WORK REGISTER
  41.  **       R10   TEXT UNIT COUNTER
  42.  **       R14   RETURN ADDRESS
  43.  **       R15   BASE REGISTER AND RETURN CODE
  44.  **
  45.           L     R2,0(R1)            GET REQUEST BLOCK POINTER
  46.           L     R8,4(R1)            GET ADDRESS
  47.           L     R8,0(R8)            TO WORK AREA
  48.  **
  49.  **       WE ARE ONLY INTERESTED IN ALLOCATION, DEALLOCATION
  50.  **       AND INFORMATION RETRIEVAL
  51.  **
  52.           USING S99RB,R2
  53.           CLI   S99VERB,S99VRBAL    ALLOCATION?
  54.           BE    DB401TXU            YES, VERB OK
  55.           CLI   S99VERB,S99VRBUN    DEALLOCATION?
  56.           BE    DB401TXU            YES, VERB OK
  57.           CLI   S99VERB,S99VRBIN    INFORMATION?
  58.           BNE   DB401END            NO, VERB NOT WANTED
  59.  **
  60.  **       FIND JCT AND FIND JOBNAME FROM TIOT
  61.  **
  62.  DB401TXU L     R3,PSATOLD-PSA      GET POINTER TO TCB
  63.           USING TCBRBP,R3
  64.           L     R4,TCBTIO           GET POINTER TO TIOT
  65.           USING TIOT,R4
  66.           EQTEST TIOT,TIOCNJOB      POINT TO JOBNAME
  67.           L     R3,TCBJSCB          GET JSCB POINTER
  68.           DROP  R3
  69.           ITL   R3,JSCBSSIB-JSCB(R3) GET THE SSIB POINTER
  70.           BZ    DB401END            NOTHING FOUND
  71.           CLC   =C'SSIB',SSIBID-SSIB(R3) VERIFY ID
  72.           BNE   DB401END            NOT CORRECT
  73.           ITL   R3,SSIBSUSE-SSIB(R3) GET THE SJB POINTER
  74.           BZ    DB401END            NOTHING FOUND
  75.           CLC   =C'SJB ',SJBID-SJB(R3) VERIFY ID
  76.           BNE   DB401END            NOT CORRECT
  77.  *        CLC   =C'JOB',SJBJOBID-SJB(R3)    VERIFY JOB
  78.  *        BNE   DB401END            LEAVE TSU AND STC AS THEY ARE
  79.           ITL   R3,SJBJCT-SJB(R3)   GET JCT POINTER
  80.           BZ    DB401END            NOTHING FOUND
  81.           CLC   =C'JCT ',JCTID-JCTDSECT(R3) VERIFY ID
  82.           BNE   DB401END            NOT CORRECT
  83.           CLC   =C'JOB',JCTJOBID-JCTDSECT(R3) VERIFY JOB
  84.           BNE   DB401END            LEAVE TSU AND STC AS THEY ARE
  85.           USING JCTDSECT,R3
  86.  **
  87.  **       FIND TEXT-UNITS THAT CONTAIN DSNAME
  88.  **
  89.           L     R2,S99TXTPP         GET ADDRESS OF LIST OF TEXT UNIT
  90.                                     POINTERS
  91.           USING S99TUPL,R2
  92.           SR    R10,R10             ZERO TEXT UNIT COUNTER
  93.  DB401NTX ICM   R5,15,S99TUPTR      GET ADDRESS OF TEXT UNIT
  94.           BZ    DB401LA             GO CHECK IF LAST UNIT
  95.           USING S99TUNIT,R5
  96.           EQTEST DALDSNAM,DUNDSNAM  MUST BE THE SAME
  97.           EQTEST DALDSNAM,DINDSNAM  MUST BE THE SAME
  98.           CLC   S99TUKEY,=AL2(DALDSNAM) COMPARE WITH KEY FOR DSNAME
  99.           BE    DB401FO             WANTED KEY FOUND
  100.           CLC   S99TUKEY,=AL2(DALVLRDS) COMPARE WITH KEY FOR VOL.REF.
  101.           BE    DB401FO             WANTED KEY FOUND
  102.           CLC   S99TUKEY,=AL2(DALDCBDS) COMPARE WITH DCB DSNAME REF.
  103.           BNE   DB401LA             WANTED KEY NOT FOUND
  104.  **
  105.  **       CHECK IF TSO PREFIXING
  106.  **
  107.  DB401FO  CLC   TIOCNJOB(5),S99TUPAR PREFIXED WITH ID?
  108.           BNE   DB401LA             NO, TEST NEXT TEXT-UNIT
  109.           CLI   S99TUPAR+5,C'.'
  110.           BNE   DB401LA             NO, TEST NEXT TEXT-UNIT
  111.           DROP  R4
  112.           MVC   0(6,R8),S99TUPAR+7  ASSUME ACCOUNT-NUMBER
  113.           OC    0(6,R8),DB4010F     CHECK IF DIGITS
  114.           CLC   0(6,R8),DB401FF
  115.           BE    DB401LA             YES, CHECK NEXT TEXT-UNIT
  116.  **
  117.  **       CONSTRUCT A NEW TEXT UNIT
  118.  **
  119.           MVC   0(4,R8),S99TUKEY    MOVE KEY AND NUMBER
  120.           LA    R6,JCTINDEX+L'JCTINDEX POINT AFTER JCTINDEX
  121.  DB401LO1 BCTR  R6,0                DECREASE POINTER
  122.           CLI   0(R6),C' '          END OF INDEX FOUND?
  123.           BE    DB401LO1            NO
  124.           LA    R7,JCTINDEX         COMPUTE LENGTH OF INDEX
  125.           SR    R6,R7
  126.           BNM   DB401MO1            NO INDEX TO MOVE
  127.           SR    R6,R6               INDEX-LENGTH IS NULL
  128.           B     DB401LEN
  129.           SPACE 3
  130.  DB401MO1 EX    R6,DB401MV1         MOVE JCT INDEX
  131.           LA    R6,1(R6)            COMPENSATE FOR REDUCED LENGTH
  132.  DB401LEN LA    R7,S99TUPAR         GET POINTER TO PARAMETER
  133.           AH    R7,S99TULNG         POINT AFTER DSNAME
  134.  DB401LO2 BCTR  R7,0                DECREASE POINTER
  135.           CLI   0(R7),C' '          END OF DSNAME?
  136.           BE    DB401LO2            NO
  137.           LA    R9,S99TUPAR+5       COMPUTE LENGTH
  138.           SR    R7,R9               OF DSNAME
  139.           BNP   DB401ST             NOTHING TO MOVE
  140.           LR    R9,R8
  141.           AR    R9,R6               WHERE TO MOVE THE REST TO
  142.           AR    R6,R7               TOTAL LENGTH OF DSNAME
  143.           CH    R6,=H'44'           MUST NOT BE GREATER THAN 44
  144.           BH    DB401ERR
  145.           BCTR  R7,0                REDUCE LENGTH
  146.           EX    R7,DB401MV2         MOVE DSNAME
  147.  DB401ST  STCM  R6,3,4(R8)          STORE LENGTH
  148.           STCM  R8,7,S99TUPTR+1     SAVE ADDRESS TO NEW TEXT UNIT
  149.           LA    R8,S99TUPAR-S99TUNIT(R6,R8) POINT TO NEW FREE SPACE
  150.           LA    R10,1(R10)          ONE TEXTUNIT ADDED
  151.           CH    R10,=H'3'           HAVE WE ALREADY TREE EXTRA?
  152.           BNL   DB401END            YES, THEN WE WON'T ADD MORE SO NOT
  153.  *                                  TO OVERFLOW THE WORK AREA. MORE THEN
  154.  *                                  TREE ADDED WILL GIVE DUPLICATES.
  155.  DB401LA  LTR   R5,R5               LAST TEXT UNIT?
  156.           BM    DB401END            YES
  157.           LA    R2,4(R2)            POINT TO NEXT TEXT UNIT POINTER
  158.           B     DB401NTX
  159.           SPACE 3
  160.  DB401ERR WTO   MF=(E,DB401)        REPORT ERROR
  161.           LM    R14,R12,12(R13)     RELOAD REGISTERS
  162.           LA    R15,8               REQUEST IS NOT TO CONTINUE
  163.           BR    R14                 RETURN
  164.           SPACE 3
  165.  DB401END LM    R14,R12,12(R13)     RELOAD REGISTERS
  166.           SR    R15,R15             REQUEST IS TO CONTINUE
  167.           BR    R14                 RETURN
  168.           SPACE 3
  169.  DB401MV1 MVC   6(*-*,R8),JCTINDEX
  170.  DB401MV2 MVC   6(*-*,R9),S99TUPAR+6
  171.           SPACE 3
  172.  DB4010F  DC    X'0F0F0F0F0F0F'
  173.  DB401FF  DC    X'FFFFFFFFFFFF'
  174.  DB401BL  DC    CL36' '             36=L'JCTINDEX
  175.           SPACE 3
  176.  DB401    WTO   'ACT0033I DSNAME EXCEEDS 44 CHARACTERS',MF=L,
  177.                 ROUTCDE=(2,11),DESC=6
  178.           PRINT © CVT,DYN,EQUATES,JCT,JSCB,PSA,SJB,SSIB,TCB,TIOT
  179.           COPY  EQUATES
  180.  CVT      CVT   SYS=&SYS
  181.  DYN      DYN   SYS=&SYS
  182.  JCTDSECT JCT   SYS=&SYS
  183.  JSCB     JSCB  SYS=&SYS
  184.  PSA      PSA   SYS=&SYS
  185.  SSIB     SSIB  SYS=&SYS
  186.  SJB      SJB   SYS=&SYS
  187.  TCBDSECT TCB   SYS=&SYS
  188.  TIOT     TIOT  SYS=&SYS
  189.           END
  190.